home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / monolith / ISTQT.MAC.f < prev   
Encoding:
Text File  |  1989-03-04  |  4.6 KB  |  150 lines
  1.         PROGRAM ISTQT
  2.  
  3.         INTEGER SRCPTH(134),CMTPTH(134),TKNPTH(134),
  4.      +          CIPTH(134),TMPPTH(134),OPTSTR(134),I,STATUS,
  5.      +          IODSRC,IODTKN,IODCMT,IODTMP,TOKNUM,IODCI,NERROR,NWARN
  6.  
  7.         INTEGER TMPFIL
  8.  
  9.         INTEGER YPARSE,GETARG,OPEN,CREATE,ZYINCI,ZTKPTI
  10.         EXTERNAL YPARSE,ZINIT,ZMESS,REMARK,ZQUIT,GETARG,OPEN,CREATE,
  11.      +           ZCHOUT,ZPTINT,PUTCH,REMOVE,SEEK,ZYINCI,ZTKPTI
  12.  
  13.         DATA (TMPPTH(I),I=1,11)/108,121,112,99,109,116,46,
  14.      +116,109,112,129/,
  15.      +       (CIPTH(I),I=1,11)/108,121,112,99,109,105,46,
  16.      +116,109,112,129/
  17.  
  18.         CALL ZINIT
  19.         CALL INISTR
  20.         CALL INISYM
  21.         CALL INITRE
  22.  
  23.         IF (GETARG(1,SRCPTH,81).EQ.-100) CALL NAMES(1,SRCPTH)
  24.         IF (GETARG(2,TKNPTH,81).EQ.-100) CALL NAMES(2,TKNPTH)
  25.         IF (GETARG(3,CMTPTH,81).EQ.-100) CALL NAMES(3,CMTPTH)
  26.         IF (GETARG(4,OPTSTR,81).EQ.-100) CALL NAMES(4,OPTSTR)
  27.  
  28.         IODSRC=OPEN(SRCPTH,0)
  29.         IF (IODSRC.EQ.-1) CALL ERROR('Source File Open Failed')
  30.         IODTKN=CREATE(TKNPTH,1)
  31.         IF (IODTKN.EQ.-1) CALL ERROR('Token Stream Create Failed')
  32.         IODCMT=CREATE(CMTPTH,1)
  33.         IF (IODCMT.EQ.-1) CALL ERROR('Comment File Create Failed')
  34.  
  35.         IODTMP=TMPFIL(TMPPTH)
  36.         IODCI=TMPFIL(CIPTH)
  37.         IF (IODTMP.EQ.-1 .OR. IODCI.EQ.-1)
  38.      +      CALL ERROR('Scratch File Creation Failed')
  39.  
  40.         IF (YPARSE(IODSRC,IODTMP,-1,IODCI,NERROR,NWARN).EQ.0) THEN
  41.             IF (NERROR.GT.0) THEN
  42.                 CALL ZCHOUT('[ISTQT Terminated, ',2)
  43.                 CALL ZPTINT(NERROR,1,2)
  44.                 CALL ZCHOUT(' er'//'ror',2)
  45.                 IF (NERROR.GT.1) CALL PUTCH(115,2)
  46.                 CALL ZMESS(']',2)
  47.                 STATUS=-1
  48.             ELSE
  49.                 CALL SEEK(0,IODCI)
  50.                 CALL SEEK(0,IODTMP)
  51.                 IF (ZYINCI(IODCI).EQ.-1) CALL ERROR(
  52.      +              'Internal Error: Couldn''t reread comment index')
  53.                 CALL PT(OPTSTR,IODTMP,ZTKPTI(1,IODTKN,IODCMT),NERROR,
  54.      +                  NWARN)
  55.                 IF (NERROR+NWARN.EQ.0) THEN
  56.                     CALL REMARK('[ISTQT Normal Termination]')
  57.                     STATUS=-2
  58.                 ELSE IF (NERROR.EQ.0) THEN
  59.                     CALL ZCHOUT('[ISTQT Terminated, ',2)
  60.                     CALL ZPTINT(NWARN,1,2)
  61.                     CALL ZCHOUT(' war'//'ning',2)
  62.                     IF (NWARN.GT.1) CALL PUTCH(115,2)
  63.                     CALL ZMESS(']',2)
  64.                     STATUS=-1002
  65.                 ELSE
  66.                     CALL ZCHOUT('[ISTQT Terminated, ',2)
  67.                     CALL ZPTINT(NERROR,1,2)
  68.                     CALL ZCHOUT(' er'//'ror',2)
  69.                     IF (NERROR.GT.1) CALL PUTCH(115,2)
  70.                     CALL ZMESS(']',2)
  71.                     STATUS=-1
  72.                 END IF
  73.             END IF
  74.         ELSE
  75.             CALL REMARK('[ISTQT Fatal Error -- Terminated]')
  76.             STATUS=-1001
  77.         END IF
  78.  
  79.         CALL CLOSE(IODTMP)
  80.         CALL CLOSE(IODCI)
  81.         CALL REMOVE(TMPPTH)
  82.         CALL REMOVE(CIPTH)
  83.  
  84.         CALL ZQUIT(STATUS)
  85.  
  86.         END
  87. C ----------------------------------------------------------------------
  88. C
  89. C       N A M E S   -   Input the pathname of a required file from stdin
  90. C
  91.  
  92.         SUBROUTINE NAMES(NUMBER,PATH)
  93.         INTEGER NUMBER,PATH(*)
  94.  
  95.         INTEGER JUNK,PROMPT(22,4)
  96.  
  97.         SAVE PROMPT
  98.  
  99.         INTEGER ZGTCMD
  100.         EXTERNAL ZGTCMD,ZPRMPT
  101.  
  102. C "Input source file: "
  103. C "Output token stream: "
  104. C "Output comment file: "
  105. C "Options: "
  106.  
  107.         DATA (PROMPT(I,1),I=1,20)/73,110,112,117,116,32,115,
  108.      +111,117,114,99,101,32,102,105,108,101,58,
  109.      +32,129/,
  110.      +       (PROMPT(I,2),I=1,22)/79,117,116,112,117,116,32,
  111.      +116,111,107,101,110,32,115,116,114,101,97,109,
  112.      +58,32,129/,
  113.      +       (PROMPT(I,3),I=1,22)/79,117,116,112,117,116,32,
  114.      +99,111,109,109,101,110,116,32,102,105,108,101,
  115.      +58,32,129/,
  116.      +       (PROMPT(I,4),I=1,10)/79,112,116,105,111,110,115,
  117.      +58,32,129/
  118.  
  119.         CALL ZPRMPT(PROMPT(1,NUMBER))
  120.         JUNK=ZGTCMD(PATH,0)
  121.         RETURN
  122.  
  123.         END
  124. C ----------------------------------------------------------------------
  125. C
  126. C       T M P F I L   -   Create a temporary file
  127. C
  128.  
  129.         INTEGER FUNCTION TMPFIL(PATH)
  130.         INTEGER PATH(81)
  131.  
  132.         INTEGER TMPNUM
  133.  
  134.         INTEGER CREATE
  135.         EXTERNAL CREATE,ZITOCP
  136.  
  137.         TMPFIL=CREATE(PATH,2)
  138.         IF (TMPFIL.NE.-1) RETURN
  139.  100    CALL ZITOCP(TMPNUM,PATH(4),3,48)
  140.         PATH(7)=46
  141.         TMPFIL=CREATE(PATH,2)
  142.         IF (TMPFIL.EQ.-1 .AND. TMPNUM.LT.999) THEN
  143.             TMPNUM=TMPNUM+1
  144.             GOTO 100
  145.         ELSE IF (TMPNUM.EQ.999) THEN
  146.             CALL ERROR('Can''t create temporary scratch file')
  147.         END IF
  148.  
  149.         END
  150.